home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / 3078B.ZIP / PGRUN991.ZIP / ROUND.LSP < prev    next >
Lisp/Scheme  |  1991-05-20  |  13KB  |  439 lines
  1.  
  2. ; *******  ParaDraft Application  ********
  3. ; Parametric Geomtry Program generated by PgPg! 
  4. ; Authored by   : User
  5. ; Application name : A round base plate with a cutout
  6. ; Dated         : Monday , 20-5-1991
  7. ; Started at    :  --  15:05:10
  8. ; Finished at   :  --  15:06:23
  9. ; ****************************************
  10. (princ "\nParaDraft application generated on Monday , 20-5-1991 with Professional Version 1.0P")
  11. (mode 0)(command "VSLIDE"(strcat *pgpg-dir* *pg-name*))
  12. (setq rad2 nil rad3 nil rad4 nil rad5 nil rad10 nil rad11 nil ang12 nil ang13 nil ang14 nil ang15 nil L1 nil L6 nil L7 nil L8 nil L9 nil  ) 
  13. (take-value 'rad2 "rad2" 69.70227894)
  14. (take-value 'rad3 "rad3" 5.53267178)
  15. (take-value 'rad4 "rad4" 6.2259894)
  16. (take-value 'rad5 "rad5" 6.21063284)
  17. (take-value 'rad10 "rad10" 17.68474515)
  18. (take-value 'rad11 "rad11" 14.15228577)
  19. (take-value 'ang12 "ang12" 44.33812998)
  20. (take-value 'ang13 "ang13" 47.34525428)
  21. (take-value 'ang14 "ang14" 21.99003602)
  22. (take-value 'ang15 "ang15" 23.50091384)
  23. (take-value 'L1 "L1" 86.71286)
  24. (take-value 'L6 "L6" 34.53981178)
  25. (take-value 'L7 "L7" 19.82967412)
  26. (take-value 'L8 "L8" 12.95807805)
  27. (take-value 'L9 "L9" 35.77494521)
  28. (command "REDRAW")
  29. (initget 1)
  30. (setq refpt (getpoint "\nInsertion point :"))
  31. (setq refangle (getval "\nInsertion angle:" 0.0))
  32.  
  33. (princ "Computing points ..please wait")
  34.  
  35. (setq *en* 
  36. (init refpt))(setq *dim-layer* "dim")(setq *cen-layer* "cen")
  37. (setq err 0.0)
  38. (command "COLOR""BYLAYER")
  39. (command "DIM1""DIMASZ" 0.01 )
  40. (command "DIM1""DIMTXT" 0.01 )
  41. (setvar "CMDECHO" 0)(MAKE_LAYER "CEN" 2)(setq ANG12(D2R ANG12 ))
  42. (setq ANG13(D2R ANG13 ))
  43. (setq ANG14(D2R ANG14 ))
  44. (setq ANG15(D2R ANG15 ))
  45. (setq L16 (/ L1 2.0)  )
  46. (setq L17 L16 )
  47. (setq L18 (/ L6 2.0)  )
  48. (setq L19 L18 )
  49. (setq L20 (/ L8 2.0)  )
  50. (setq L21 L20 )
  51.  
  52. (setq pt1(delta refpt 
  53.                         0.0
  54.                         0.0
  55.         ))
  56. (setq pt3(delta refpt 
  57.                         ( + (x-of pt1) rad2) 
  58.                         (y-of pt1)
  59.         ))
  60. (setq pt38(delta refpt 
  61.                         ( + (x-of pt1) rad10) 
  62.                         (y-of pt1)
  63.         ))
  64. (setq pt8(delta refpt 
  65.                         (x-of pt1)
  66.                         ( + (y-of pt1) ( - L16 )) 
  67.         ))
  68. (setq pt10(delta refpt 
  69.                         (x-of pt1)
  70.                         ( + (y-of pt1) L17) 
  71.         ))
  72. (setq pt39(polar 
  73.                          pt1 
  74.                         (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  75.  )) ))
  76.                         L19
  77.         ))
  78. (setq pt21(polar 
  79.                          pt1 
  80.                         (chg-quad (  -  1.57079633 ANG12
  81.  )) 
  82.                         ( - L9 )
  83.         ))
  84. (setq pt31(polar 
  85.                          pt1 
  86.                         (chg-quad (  -  1.57079633 ANG12
  87.  )) 
  88.                         ( - L7 )
  89.         ))
  90. (setq pt40(polar 
  91.                          pt1 
  92.                         (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  93.  )) ))
  94.                         ( - L18 )
  95.         ))
  96. (setq pt41(delta refpt 
  97.                         ( + (x-of pt21) rad11) 
  98.                         (y-of pt21)
  99.         ))
  100. (setq pt42(polar 
  101.                          pt31 
  102.                         (chg-quad (  -  1.57079633 ANG12
  103.  )) 
  104.                         L21
  105.         ))
  106. (setq pt37(polar 
  107.                          pt31 
  108.                         (chg-quad (  -  1.57079633 ANG12
  109.  )) 
  110.                         ( - L20 )
  111.         ))
  112. (setq pt15(intersect 
  113.                         (make-arc  pt1  pt8 )
  114.                         (make-line  pt1 (chg-quad (  - (chg-quad (  +  1.57079633 ANG13
  115.  )) ANG14
  116.  )) )
  117.                          '- 
  118.         ))
  119. (setq pt43(delta refpt 
  120.                         ( + (x-of pt15) rad5) 
  121.                         (y-of pt15)
  122.         ))
  123. (setq pt16(intersect 
  124.                         (make-arc  pt1  pt8 )
  125.                         (make-line  pt1 (chg-quad (  +  1.57079633 ANG13
  126.  )) )
  127.                          '- 
  128.         ))
  129. (setq pt17(intersect 
  130.                         (make-arc  pt1  pt8 )
  131.                         (make-line  pt1 (chg-quad (  + (chg-quad (  +  1.57079633 ANG13
  132.  )) ANG15
  133.  )) )
  134.                          '- 
  135.         ))
  136. (setq pt44(delta refpt 
  137.                         ( + (x-of pt16) rad4) 
  138.                         (y-of pt16)
  139.         ))
  140. (setq pt45(delta refpt 
  141.                         ( + (x-of pt17) rad3) 
  142.                         (y-of pt17)
  143.         ))
  144. (setq pt18(intersect 
  145.                         (make-arc  pt1  pt38 )
  146.                         (make-line  pt42 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  147.  )) )))
  148.                          '+ 
  149.         ))
  150. (setq pt19(intersect 
  151.                         (make-arc  pt1  pt38 )
  152.                         (make-line  pt42 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  153.  )) )))
  154.                          '- 
  155.         ))
  156. (setq pt20(intersect 
  157.                         (make-line  pt42 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  158.  )) )))
  159.                         (make-line  pt39 (chg-quad (  -  1.57079633 ANG12
  160.  )) )
  161.                          Nil 
  162.         ))
  163. (setq pt28(intersect 
  164.                         (make-line  pt42 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  165.  )) )))
  166.                         (make-line  pt40 (chg-quad (  -  1.57079633 ANG12
  167.  )) )
  168.                          Nil 
  169.         ))
  170. (setq pt26(intersect 
  171.                         (make-line  pt39 (chg-quad (  -  1.57079633 ANG12
  172.  )) )
  173.                         (make-line  pt31 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  174.  )) )))
  175.                          Nil 
  176.         ))
  177. (setq pt27(intersect 
  178.                         (make-line  pt39 (chg-quad (  -  1.57079633 ANG12
  179.  )) )
  180.                         (make-line  pt37 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  181.  )) )))
  182.                          Nil 
  183.         ))
  184. (setq pt29(intersect 
  185.                         (make-line  pt40 (chg-quad (  -  1.57079633 ANG12
  186.  )) )
  187.                         (make-line  pt31 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  188.  )) )))
  189.                          Nil 
  190.         ))
  191. (setq pt30(intersect 
  192.                         (make-line  pt40 (chg-quad (  -  1.57079633 ANG12
  193.  )) )
  194.                         (make-line  pt37 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  195.  )) )))
  196.                          Nil 
  197.         ))
  198. (setq pt22(intersect 
  199.                         (make-arc  pt21  pt41 )
  200.                         (make-line  pt37 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  201.  )) )))
  202.                          '+ 
  203.         ))
  204. (setq pt23(intersect 
  205.                         (make-arc  pt21  pt41 )
  206.                         (make-line  pt37 (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  207.  )) )))
  208.                          '- 
  209.         ))
  210. (princ "Computed points\n")(gc)
  211. (make_layer "0" 1)
  212. (make_layer "cen" 1)
  213. (make_layer "dim" 1)
  214. (make_layer "0" 1)
  215. (command "LINE" pt20 pt19 "" )
  216. (command "LINE" pt26 pt27 "" )
  217. (command "LINE" pt28 pt18 "" )
  218. (command "LINE" pt29 pt30 "" )
  219. (command "LINE" pt30 pt23 "" )
  220. (command "LINE" pt27 pt22 "" )
  221. (command "LINE" pt28 pt29 "" )
  222. (command "LINE" pt20 pt26 "" )
  223. (command "CIRCLE" pt1  rad2)
  224. (setq ent1 (entlast))(command "CIRCLE" pt15  rad5)
  225. (setq ent2 (entlast))(command "CIRCLE" pt16  rad4)
  226. (setq ent3 (entlast))(command "CIRCLE" pt17  rad3)
  227. (setq ent4 (entlast))(command "ARC""C" pt1 pt18 pt19)
  228. (setq ent5 (entlast))(command "ARC""C" pt21 pt22 pt23)
  229. (setq ent6 (entlast))
  230. (draw-cline  pt3 332.7631 0.0  ) 
  231. (draw-cline  pt1 127.02554872(chg-quad (  -  1.57079633 ANG12
  232.  ))  ) 
  233. (draw-cline  pt26 110.79546524(chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  234.  )) )) ) (make-cline  pt1  rad2)
  235. (make-cline  pt15  rad5)
  236. (make-cline  pt16  rad4)
  237. (make-cline  pt17  rad3)
  238.  
  239. (setq *detailing* T) (init refpt)
  240. (setq L22 128.86431583 )
  241. (command "DIM1""VERT" pt10  pt8 (setq pt46(polar 
  242.                          pt10 
  243.                          0.0 
  244.                         L22
  245.         )) "")
  246. (setq L23 2.26173408 )
  247. (command "DIM1""ROTATED"(r2d (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  248.  )) )))  pt27  pt30 (setq pt47(polar 
  249.                          pt30 
  250.                         (chg-quad (  -  1.57079633 ANG12
  251.  )) 
  252.                         L23
  253.         )) "")
  254. (setq L24 31.07176287 )
  255. (command "DIM1""ROTATED"(r2d (chg-quad (  -  1.57079633 ANG12
  256.  )) )  pt1  pt31 (setq pt48(polar 
  257.                          pt31 
  258.                         (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  259.  )) ))
  260.                         ( - L24 )
  261.         )) "")
  262. (setq L25 11.5115572 )
  263. (command "DIM1""ROTATED"(r2d (chg-quad (  -  1.57079633 ANG12
  264.  )) )  pt20  pt27 (setq pt49(polar 
  265.                          pt20 
  266.                         (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  267.  )) ))
  268.                         L25
  269.         )) "")
  270. (setq L26 28.57708641 )
  271. (command "DIM1""ROTATED"(r2d (chg-quad (  -  1.57079633 ANG12
  272.  )) )  pt1  pt21 (setq pt50(polar 
  273.                          pt1 
  274.                         (chg-quad (+ 1.5707963(chg-quad (  -  1.57079633 ANG12
  275.  )) ))
  276.                         L26
  277.         )) "")
  278.  
  279. (command "DIM1""radius" (list ent1 (polar  pt1 0.78539816 10.0))"")
  280.  
  281. (command "DIM1""radius" (list ent4 (polar  pt17 0.78539816 10.0))"")
  282.  
  283. (command "DIM1""radius" (list ent3 (polar  pt16 0.78539816 10.0))"")
  284.  
  285. (command "DIM1""radius" (list ent2 (polar  pt15 0.78539816 10.0))"")
  286.  
  287. (command "DIM1""radius" (list ent5  (midpt  pt18  pt19 ) )"")
  288.  
  289. (command "DIM1""radius" (list ent6  (midpt  pt22  pt23 ) )"")
  290. (setq L27 100.0 )
  291. (setq pt51(polar 
  292.                          pt1 
  293.                         (chg-quad (  -  1.57079633 ANG12
  294.  )) 
  295.                         L27
  296.         )) (setq L28 100.0 )
  297. (setq pt52(polar 
  298.                          pt1 
  299.                          1.57079633 
  300.                         L28
  301.         )) (command "LINE" pt1  pt51  "" )
  302. (setq ent7 (entlast))(command "LINE" pt1  pt52  "" )
  303. (setq ent8 (entlast))(command "DIM1""ANGULAR" (list ent7  pt51 ) (list ent8  pt52 ) (midpt  pt51  pt52 ) "" "" )
  304. (setq L29 110.0 )
  305. (setq pt53(polar 
  306.                          pt1 
  307.                          1.57079633 
  308.                         L29
  309.         )) (setq L30 110.0 )
  310. (setq pt54(polar 
  311.                          pt1 
  312.                         (chg-quad (  +  1.57079633 ANG13
  313.  )) 
  314.                         L30
  315.         )) (command "LINE" pt1  pt53  "" )
  316. (setq ent8 (entlast))(command "LINE" pt1  pt54  "" )
  317. (setq ent9 (entlast))(command "DIM1""ANGULAR" (list ent8  pt53 ) (list ent9  pt54 ) (midpt  pt53  pt54 ) "" "" )
  318. (setq L31 120.0 )
  319. (setq pt55(polar 
  320.                          pt1 
  321.                         (chg-quad (  - (chg-quad (  +  1.57079633 ANG13
  322.  )) ANG14
  323.  )) 
  324.                         L31
  325.         )) (setq L32 120.0 )
  326. (setq pt56(polar 
  327.                          pt1 
  328.                         (chg-quad (  +  1.57079633 ANG13
  329.  )) 
  330.                         L32
  331.         )) (command "LINE" pt1  pt55  "" )
  332. (setq ent10 (entlast))(command "LINE" pt1  pt56  "" )
  333. (setq ent9 (entlast))(command "DIM1""ANGULAR" (list ent10  pt55 ) (list ent9  pt56 ) (midpt  pt55  pt56 ) "" "" )
  334. (setq L33 130.0 )
  335. (setq pt57(polar 
  336.                          pt1 
  337.                         (chg-quad (  +  1.57079633 ANG13
  338.  )) 
  339.                         L33
  340.         )) (setq L34 130.0 )
  341. (setq pt58(polar 
  342.                          pt1 
  343.                         (chg-quad (  + (chg-quad (  +  1.57079633 ANG13
  344.  )) ANG15
  345.  )) 
  346.                         L34
  347.         )) (command "LINE" pt1  pt57  "" )
  348. (setq ent9 (entlast))(command "LINE" pt1  pt58  "" )
  349. (setq ent11 (entlast))(command "DIM1""ANGULAR" (list ent9  pt57 ) (list ent11  pt58 ) (midpt  pt57  pt58 ) "" "" )
  350.  
  351. (command "DIM1""DIMASZ" 3.0 )
  352. (command "DIM1""DIMTXT" 3.0 )
  353. (command "DIM1""UPDATE"(getset) "" )
  354. ( command "CHANGE""P" "" "LAYER" *dim-layer* )
  355.  
  356.  
  357.  
  358. (rotate-it refpt refangle)
  359. (princ "\n Drawing created by a ParaDraft application")(mode 1) ( setq refpt nil 
  360.  pt1 nil 
  361.  pt2 nil 
  362.  pt3 nil 
  363.  pt4 nil 
  364.  pt5 nil 
  365.  pt6 nil 
  366.  pt7 nil 
  367.  pt8 nil 
  368.  pt9 nil 
  369.  pt10 nil 
  370.  pt11 nil 
  371.  pt12 nil 
  372.  pt13 nil 
  373.  pt14 nil 
  374.  pt15 nil 
  375.  pt16 nil 
  376.  pt17 nil 
  377.  pt18 nil 
  378.  pt19 nil 
  379.  pt20 nil 
  380.  pt21 nil 
  381.  pt22 nil 
  382.  pt23 nil 
  383.  pt24 nil 
  384.  pt25 nil 
  385.  pt26 nil 
  386.  pt27 nil 
  387.  pt28 nil 
  388.  pt29 nil 
  389.  pt30 nil 
  390.  pt31 nil 
  391.  pt37 nil 
  392.  pt38 nil 
  393.  pt39 nil 
  394.  pt40 nil 
  395.  pt41 nil 
  396.  pt42 nil 
  397.  pt43 nil 
  398.  pt44 nil 
  399.  pt45 nil 
  400.  pt46 nil 
  401.  pt47 nil 
  402.  pt48 nil 
  403.  pt49 nil 
  404.  pt50 nil 
  405.  pt51 nil 
  406.  pt52 nil 
  407.  pt53 nil 
  408.  pt54 nil 
  409.  pt55 nil 
  410.  pt56 nil 
  411.  pt57 nil 
  412.  pt58 nil 
  413.  L1 nil 
  414.  L6 nil 
  415.  L7 nil 
  416.  L8 nil 
  417.  L9 nil 
  418.  L16 nil 
  419.  L17 nil 
  420.  L18 nil 
  421.  L19 nil 
  422.  L20 nil 
  423.  L21 nil 
  424.  L22 nil 
  425.  L23 nil 
  426.  L24 nil 
  427.  L25 nil 
  428.  L26 nil 
  429.  L27 nil 
  430.  L28 nil 
  431.  L29 nil 
  432.  L30 nil 
  433.  L31 nil 
  434.  L32 nil 
  435.  L33 nil 
  436.  L34 nil 
  437.  ) 
  438. (gc) (princ) ; Program generated at  :  --  15:06:34
  439.